home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / vis082s.arc / WINDOWS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-18  |  4.4 KB  |  218 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+ }
  2.  
  3. unit windows;
  4.  
  5. interface
  6.  
  7. uses gensubs,gentypes,crt,subs1,configrt,modem;
  8.  
  9. var winds:array [0..2] of windowrec;
  10.     split,inuse:integer;
  11.  
  12. procedure getcoor;
  13. procedure usewind (n:byte);
  14. procedure setwind (n:byte; nx1,ny1,nx2,ny2:byte);
  15. procedure initwind (n,nx1,ny1,nx2,ny2,ncolor:byte);
  16. procedure top;
  17. procedure bottom;
  18. procedure wholescreen;
  19. procedure drawsplit;
  20. procedure initwinds;
  21. procedure unsplit;
  22. procedure splitscreen (v:byte);
  23. procedure setoutlock (b:boolean);
  24. procedure bottomline;
  25. procedure clearscr;
  26.  
  27. implementation
  28.  
  29. procedure getcoor;
  30. begin
  31.   with winds[inuse] do begin
  32.     cx:=wherex;
  33.     cy:=wherey;
  34.     if cy<1 then cy:=1;
  35.     if cy>(y2-y1)+1 then cy:=(y2-y1)+1
  36.   end
  37. end;
  38.  
  39. procedure usewind (n:byte);
  40. begin
  41.   getcoor;
  42.   inuse:=n;
  43.   with winds[n] do begin
  44.     window (x1,y1,x2,y2);
  45.     gotoxy (cx,cy);
  46.     textcolor (color);
  47.     textbackground (0);
  48.     lasty:=y2-y1+1
  49.   end
  50. end;
  51.  
  52. procedure setwind (n:byte; nx1,ny1,nx2,ny2:byte);
  53. var i:integer;
  54. begin
  55.   i:=inuse;
  56.   usewind(n);
  57.   with winds[n] do begin
  58.     x1:=nx1;
  59.     y1:=ny1;
  60.     x2:=nx2;
  61.     y2:=ny2
  62.   end;
  63.   usewind(n);
  64.   if n<>i then usewind(i)
  65. end;
  66.  
  67. procedure initwind (n,nx1,ny1,nx2,ny2,ncolor:byte);
  68. begin
  69.   with winds[n] do begin
  70.     x1:=nx1;
  71.     y1:=ny1;
  72.     x2:=nx2;
  73.     y2:=ny2;
  74.     cx:=1;
  75.     cy:=1;
  76.     color:=ncolor
  77.   end
  78. end;
  79.  
  80. procedure top;
  81. begin
  82.   usewind (1)
  83. end;
  84.  
  85. procedure bottom;
  86. begin
  87.   usewind (2)
  88. end;
  89.  
  90. procedure wholescreen;
  91. begin
  92.   usewind (0);
  93.   inuse:=0;
  94. end;
  95.  
  96. procedure drawsplit;
  97. var cnt:integer;
  98. begin
  99.   usewind (0);
  100.   textcolor (configset.splitcolo);
  101.   gotoxy (1,split);
  102.   for cnt:=0 to 79 do write (usr,chr(196));
  103.   bottom
  104. end;
  105.  
  106. procedure initwinds;
  107. begin
  108.   splitmode:=false;
  109.   initwind (0,1,1,80,25,configset.splitcolo);
  110.   If usebottom then initwind (2,1,1,80,23,configset.normbotcolo) Else
  111.   initwind (2,1,1,80,25,configset.normbotcolo);
  112.   split:=0;
  113.   inuse:=0;
  114.   bottom
  115. end;
  116.  
  117. procedure unsplit;
  118. var y:integer;
  119. begin
  120.   if not splitmode then exit;
  121.   if inuse=2
  122.     then y:=wherey
  123.     else y:=winds[2].cy;
  124.   y:=y+split;
  125.   If Usebottom then setwind (2,1,1,80,23) Else
  126.   setwind (2,1,1,80,25);
  127.   setwind (1,1,1,80,split);
  128.   top;
  129.   clrscr;
  130.   splitmode:=false;
  131.   bottom;
  132.   gotoxy (wherex,y)
  133. end;
  134.  
  135. procedure splitscreen (v:byte);
  136. var x,y:integer;
  137. begin
  138.   if splitmode then unsplit;
  139.   x:=wherex;
  140.   y:=wherey-v;
  141.   splitmode:=true;
  142.   split:=v;
  143.   drawsplit;
  144.   initwind (1,1,1,80,split-1,configset.normtopcolo);
  145.   If usebottom then setwind (2,1,split+1,80,23) Else
  146.   setwind (2,1,split+1,80,25);
  147.   top;
  148.   clrscr;
  149.   bottom;
  150.   gotoxy (x,y)
  151. end;
  152.  
  153. procedure setoutlock (b:boolean);
  154. begin
  155.   modemoutlock:=b;
  156.   if b
  157.     then winds[2].color:=configset.outlockcolo
  158.     else winds[2].color:=configset.normbotcolo;
  159.   if inuse=2 then usewind (2)
  160. end;
  161.  
  162. procedure bottomline;
  163. var o:integer;
  164.    kenny:string[25];
  165.  
  166.   procedure flash (q:mstr);
  167.   begin
  168.     textcolor (31);
  169.     write (usr,q);
  170.     textcolor (15)
  171.   end;
  172.  
  173. begin
  174.   If not usebottom then Inuse:=0;
  175.   if (inuse=0) or (unum < 1) then exit;
  176.   o:=inuse;
  177.   wholescreen;
  178.   gotoxy (1,24);
  179.   textcolor (15);
  180.   textbackground (configset.statlinecolo);
  181.   if timelock then settimeleft (lockedtime);
  182.   write (usr,'[',unam,'] Lvl: ',ulvl,' Flvl: ',urec.udlevel,' [',datestr(laston),'] TL: ',timeleft,' FP: ',urec.udpoints);
  183.   write(usr,' [');
  184.   if local then write(usr,'Local') else write(usr,connectbaud);
  185.   write(usr,']');
  186.   if pos('ARQ',matrix)>0 then write(usr,' *MNP*');
  187.   clreol;
  188.   gotoxy(1,25);
  189.     if timelock and not chatmode then flash ('Timelock ');
  190.     if hackattempts>1 then flash('Hacker ');
  191.   if modeminlock and not chatmode then flash ('InLock ');
  192.   if modemoutlock and not chatmode then flash ('OutLock ');
  193.   if texttrap and not chatmode then flash ('■ TEXTTRAP ■');
  194.   if tempsysop and not chatmode then flash ('*Sysop* ');
  195.   if printerecho and not chatmode then flash ('Print ');
  196.   if sysnext and not chatmode then flash ('Sysop next ');
  197.   if chatmode then write(usr,'Chat:',copy(chatreason,0,70))
  198.     else write(usr,'Avail: ',sysopavailstr);
  199.     kenny:=urec.usernote;
  200.     if not chatmode then  write(usr,' [',kenny,']');
  201.   clreol;
  202.   usewind (o);
  203. end;
  204.  
  205. procedure clearscr;
  206. begin
  207.  sendchar(#27);
  208.  SendChar('[');
  209.  SendChar('2');
  210.  SendChar('J');
  211.  If Not SplitMode then ClrScr;
  212.  if (inuse<>0) and UseBottom then BottomLine;
  213. end;
  214.  
  215. begin
  216. end.
  217.  
  218.